﻿Imports System.Drawing
''' <summary>
''' HLS RGB 颜色转换部分代码来自网络的C#
''' </summary>
''' <remarks></remarks>
Module ColorBase
    Dim kRGBmax As Integer = 255
    Dim kHLSmax As Integer = 240
    Dim HLSmax As Integer = 0
    Public Function ColorFromHLS(ByVal hue As Integer, ByVal luminance As Integer, ByVal saturation As Integer) As Color
        Return ColorHLSToRGB(hue, luminance, saturation)
    End Function
    Private Function GetColorHue(ByVal color As Color) As Integer
        Return CType(Math.Round((color.GetHue * (kHLSmax / 360))), Integer)
    End Function
    Private Function GetColorLuminance(ByVal color As Color) As Integer
        Return CType(Math.Round((color.GetBrightness * kHLSmax)), Integer)
    End Function
    Private Function GetColorSaturation(ByVal color As Color) As Integer
        Return CType(Math.Round((color.GetSaturation * kHLSmax)), Integer)
    End Function
    Public Sub ColorRGBToHLS(ByVal color As Color, ByRef hue As Integer, ByRef luminance As Integer, ByRef saturation As Integer)
        hue = GetColorHue(color)
        luminance = GetColorLuminance(color)
        saturation = GetColorSaturation(color)
    End Sub
    Public Function ColorHLSToRGB(ByVal hue As Integer, ByVal luminance As Integer, ByVal saturation As Integer) As Color
        Return HLSToRGB(hue, luminance, saturation)
    End Function
    Public Function HLSToRGB(ByVal hue As Integer, ByVal luminance As Integer, ByVal saturation As Integer) As Color
        Dim b As Integer
        Dim r As Integer
        Dim g As Integer
        Dim n2 As Integer
        Dim n1 As Integer
        Dim HLSMax3 As Integer
        Dim HLSMax2 As Integer
        If (HLSmax = 0) Then
            HLSmax = kHLSmax
        End If
        If (saturation = 0) Then
            r = ((luminance * kRGBmax) / HLSmax)
            g = r
            b = r
        Else
            HLSMax2 = (HLSmax / 2)
            HLSMax3 = (HLSmax / 3)
            If (luminance <= HLSMax2) Then
                n2 = (((luminance * (HLSmax + saturation)) + HLSMax2) / HLSmax)
            Else
                n2 = (luminance + (saturation - (((luminance * saturation) + HLSMax2) / HLSmax)))
            End If
            n1 = ((2 * luminance) - n2)
            r = (((zHueToRGB(n1, n2, (hue + HLSMax3)) * kRGBmax) + HLSMax2) / HLSmax)
            g = (((zHueToRGB(n1, n2, hue) * kRGBmax) + HLSMax2) / HLSmax)
            b = (((zHueToRGB(n1, n2, (hue - HLSMax3)) * kRGBmax) + HLSMax2) / HLSmax)
        End If
        If r > 255 Then r = 255
        If g > 255 Then g = 255
        If b > 255 Then b = 255
        Return Color.FromArgb(r, g, b)
    End Function
    Private Function zHueToRGB(ByVal n1 As Integer, ByVal n2 As Integer, ByVal hue As Integer) As Integer
        If (hue < 0) Then
            hue = (hue + HLSmax)
        End If
        If (hue > HLSmax) Then
            hue = (hue - HLSmax)
        End If
        If (hue < (HLSmax / 6)) Then
            Return (n1 + ((((n2 - n1) * hue) + (HLSmax / 12)) / (HLSmax / 6)))
        ElseIf (hue < (HLSmax / 2)) Then
            Return n2
        ElseIf (hue < ((HLSmax * 2) / 3)) Then
            Return (n1 + ((((n2 - n1) * (((HLSmax * 2) / 3) - hue)) + (HLSmax / 12)) / (HLSmax / 6)))
        Else
            Return n1
        End If
    End Function
    Function GetColorInteger(ByVal mColor As Color) As String
        Dim rtn As String
        rtn = IIf(Hex(mColor.R).Length = 1, "0" & Hex(mColor.R), Hex(mColor.R))
        rtn = rtn & IIf(Hex(mColor.G).Length = 1, "0" & Hex(mColor.G), Hex(mColor.G))
        rtn = rtn & IIf(Hex(mColor.B).Length = 1, "0" & Hex(mColor.B), Hex(mColor.B))
        Return rtn
    End Function

    ''' <summary>
    ''' 通过主题色获取背景色
    ''' </summary>
    ''' <param name="mThemeColor">主题色</param>
    ''' <param name="mL">背景色亮度(建议200以上)</param>
    ''' <returns>背景色</returns>
    ''' <remarks>通过提高颜色的亮度来获取背景色</remarks>
    Function GetBackColorByThemeColor(ByVal mThemeColor As Color, ByVal mL As Byte) As Color
        Dim H, L, S As Byte
        ColorRGBToHLS(mThemeColor, H, L, S)
        L = mL
        GetBackColorByThemeColor = ColorHLSToRGB(H, L, S)
    End Function
    ''' <summary>
    ''' 黄金分割法（前景背景亮度相差148）
    ''' </summary>
    ''' <param name="mThemeColor"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetBackColorByThemeColor(ByVal mThemeColor As Color) As Color
        '240*0.618 = 148
        Dim H, L, S As Byte
        ColorRGBToHLS(mThemeColor, H, L, S)
        If L < 92 Then
            L += 148
        Else
            If L > 148 Then
                L -= 148
            Else
                L = 200
            End If
        End If
        GetBackColorByThemeColor = ColorHLSToRGB(H, L, S)
    End Function
End Module
